home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / util / Mac F2C 1.3.sit / Mac F2C 1.3 / Mac F2C Libraries / libI77 Sources / wref.c < prev    next >
C/C++ Source or Header  |  1995-01-28  |  4KB  |  248 lines
  1. #include "f2c.h"
  2. #include "fio.h"
  3. #include "fmt.h"
  4. #include "fp.h"
  5. #ifndef VAX
  6. #include "ctype.h"
  7. #endif
  8.  
  9. #ifndef KR_headers
  10. #undef abs
  11. #undef min
  12. #undef max
  13. #include "stdlib.h"
  14. #include "string.h"
  15. #endif
  16.  
  17. #ifdef KR_headers
  18. wrt_E(p,w,d,e,len) ufloat *p; ftnlen len;
  19. #else
  20. wrt_E(ufloat *p, int w, int d, int e, ftnlen len)
  21. #endif
  22. {
  23.     char buf[FMAX+EXPMAXDIGS+4], *s, *se;
  24.     int d1, delta, e1, i, sign, signspace;
  25.     double dd;
  26. #ifndef VAX
  27.     int e0 = e;
  28. #endif
  29.  
  30.     if(e <= 0)
  31.         e = 2;
  32.     if(f__scale) {
  33.         if(f__scale >= d + 2 || f__scale <= -d)
  34.             goto nogood;
  35.         }
  36.     if(f__scale <= 0)
  37.         --d;
  38.     if (len == sizeof(real))
  39.         dd = p->pf;
  40.     else
  41.         dd = p->pd;
  42.     if (dd < 0.) {
  43.         signspace = sign = 1;
  44.         dd = -dd;
  45.         }
  46.     else {
  47.         sign = 0;
  48.         signspace = (int)f__cplus;
  49. #ifndef VAX
  50.         if (!dd)
  51.             dd = 0.;    /* avoid -0 */
  52. #endif
  53.         }
  54.     delta = w - (2 /* for the . and the d adjustment above */
  55.             + 2 /* for the E+ */ + signspace + d + e);
  56.     if (delta < 0) {
  57. nogood:
  58.         while(--w >= 0)
  59.             PUT('*');
  60.         return(0);
  61.         }
  62.     if (f__scale < 0)
  63.         d += f__scale;
  64.     if (d > FMAX) {
  65.         d1 = d - FMAX;
  66.         d = FMAX;
  67.         }
  68.     else
  69.         d1 = 0;
  70.     sprintf(buf,"%#.*E", d, dd);
  71. #ifndef VAX
  72.     /* check for NaN, Infinity */
  73.     if (!isdigit(buf[0])) {
  74.         switch(buf[0]) {
  75.             case 'n':
  76.             case 'N':
  77.                 signspace = 0;    /* no sign for NaNs */
  78.             }
  79.         delta = w - strlen(buf) - signspace;
  80.         if (delta < 0)
  81.             goto nogood;
  82.         while(--delta >= 0)
  83.             PUT(' ');
  84.         if (signspace)
  85.             PUT(sign ? '-' : '+');
  86.         for(s = buf; *s; s++)
  87.             PUT(*s);
  88.         return 0;
  89.         }
  90. #endif
  91.     se = buf + d + 3;
  92. #ifdef GOOD_SPRINTF_EXPONENT /* When possible, exponent has 2 digits. */
  93.     if (f__scale != 1 && dd)
  94. #endif
  95.         sprintf(se, "%+.2d", atoi(se) + 1 - f__scale);
  96.     s = ++se;
  97.     if (e < 2) {
  98.         if (*s != '0')
  99.             goto nogood;
  100.         }
  101. #ifndef VAX
  102.     /* accommodate 3 significant digits in exponent */
  103.     if (s[2]) {
  104. #ifdef Pedantic
  105.         if (!e0 && !s[3])
  106.             for(s -= 2, e1 = 2; s[0] = s[1]; s++);
  107.  
  108.     /* Pedantic gives the behavior that Fortran 77 specifies,    */
  109.     /* i.e., requires that E be specified for exponent fields    */
  110.     /* of more than 3 digits.  With Pedantic undefined, we get    */
  111.     /* the behavior that Cray displays -- you get a bigger        */
  112.     /* exponent field if it fits.    */
  113. #else
  114.         if (!e0) {
  115.             for(s -= 2, e1 = 2; s[0] = s[1]; s++)
  116. #ifdef CRAY
  117.                 delta--;
  118.             if ((delta += 4) < 0)
  119.                 goto nogood
  120. #endif
  121.                 ;
  122.             }
  123. #endif
  124.         else if (e0 >= 0)
  125.             goto shift;
  126.         else
  127.             e1 = e;
  128.         }
  129.     else
  130.  shift:
  131. #endif
  132.         for(s += 2, e1 = 2; *s; ++e1, ++s)
  133.             if (e1 >= e)
  134.                 goto nogood;
  135.     while(--delta >= 0)
  136.         PUT(' ');
  137.     if (signspace)
  138.         PUT(sign ? '-' : '+');
  139.     s = buf;
  140.     i = f__scale;
  141.     if (f__scale <= 0) {
  142.         PUT('.');
  143.         for(; i < 0; ++i)
  144.             PUT('0');
  145.         PUT(*s);
  146.         s += 2;
  147.         }
  148.     else if (f__scale > 1) {
  149.         PUT(*s);
  150.         s += 2;
  151.         while(--i > 0)
  152.             PUT(*s++);
  153.         PUT('.');
  154.         }
  155.     if (d1) {
  156.         se -= 2;
  157.         while(s < se) PUT(*s++);
  158.         se += 2;
  159.         do PUT('0'); while(--d1 > 0);
  160.         }
  161.     while(s < se)
  162.         PUT(*s++);
  163.     if (e < 2)
  164.         PUT(s[1]);
  165.     else {
  166.         while(++e1 <= e)
  167.             PUT('0');
  168.         while(*s)
  169.             PUT(*s++);
  170.         }
  171.     return 0;
  172.     }
  173.  
  174. #ifdef KR_headers
  175. wrt_F(p,w,d,len) ufloat *p; ftnlen len;
  176. #else
  177. wrt_F(ufloat *p, int w, int d, ftnlen len)
  178. #endif
  179. {
  180.     int d1, sign, n;
  181.     double x;
  182.     char *b, buf[MAXINTDIGS+MAXFRACDIGS+4], *s;
  183.  
  184.     x= (len==sizeof(real)?p->pf:p->pd);
  185.     if (d < MAXFRACDIGS)
  186.         d1 = 0;
  187.     else {
  188.         d1 = d - MAXFRACDIGS;
  189.         d = MAXFRACDIGS;
  190.         }
  191.     if (x < 0.)
  192.         { x = -x; sign = 1; }
  193.     else {
  194.         sign = 0;
  195. #ifndef VAX
  196.         if (!x)
  197.             x = 0.;
  198. #endif
  199.         }
  200.  
  201.     if (n = f__scale)
  202.         if (n > 0)
  203.             do x *= 10.; while(--n > 0);
  204.         else
  205.             do x *= 0.1; while(++n < 0);
  206.  
  207. #ifdef USE_STRLEN
  208.     sprintf(b = buf, "%#.*f", d, x);
  209.     n = strlen(b) + d1;
  210. #else
  211.     n = sprintf(b = buf, "%#.*f", d, x) + d1;
  212. #endif
  213.  
  214.     if (buf[0] == '0' && d)
  215.         { ++b; --n; }
  216.     if (sign) {
  217.         /* check for all zeros */
  218.         for(s = b;;) {
  219.             while(*s == '0') s++;
  220.             switch(*s) {
  221.                 case '.':
  222.                     s++; continue;
  223.                 case 0:
  224.                     sign = 0;
  225.                 }
  226.             break;
  227.             }
  228.         }
  229.     if (sign || f__cplus)
  230.         ++n;
  231.     if (n > w) {
  232.         while(--w >= 0)
  233.             PUT('*');
  234.         return 0;
  235.         }
  236.     for(w -= n; --w >= 0; )
  237.         PUT(' ');
  238.     if (sign)
  239.         PUT('-');
  240.     else if (f__cplus)
  241.         PUT('+');
  242.     while(n = *b++)
  243.         PUT(n);
  244.     while(--d1 >= 0)
  245.         PUT('0');
  246.     return 0;
  247.     }
  248.